home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / bluesbox.arc / BLUESBOX.BAS
Encoding:
BASIC Source File  |  1985-09-27  |  22.2 KB  |  258 lines
  1. 10 ON ERROR GOTO 30000:CLS:OPTION BASE 1:KEY OFF:DEFINT A-Z:MAX=&H29A
  2. 50 DEF FNL2!(X)=LOG(X)/LOG(2):DEF FNS$(N$)=RIGHT$(N$,LEN(N$)-1):TRUE=-1:FALSE=0:FLAT=FALSE:SHARP=FALSE:OC=3:CN$="C":SCALE$="CDEFGAB":NN=7*OC-6
  3. 70 STAFFX=6:STAFFY=55:PTN$="":X$="C C#D E-E F F#G A-A B-B ":FOR X=1 TO 5:PTN$=PTN$+X$:NEXT:PSCALE$="C.D.EF.G.A.B":PTNPTR=(12*(OC-1)+INSTR(PSCALE$,CN$)-SHARP+FLAT)*2-1
  4. 90 KBX=123:KBY=6:NX=6:NY=160:RX=6:RY=180:MIDC=30:NDX=STAFFX+49:RDX=NDX-2:RDY=STAFFY:IBL=0:R=0:BS=0
  5. 100 TEMPO=100:DOTTED=FALSE:NOTE=TRUE:PREVNOTE=NOTE:TIME=4:PREVTIME=TIME:PREVDOT=DOTTED:PREVPTR=PTNPTR:BCOUNT=0:BPOS=0:NCOUNT=1:NPOS=1:INSERTING=FALSE
  6. 110 DIM NCURS(38),SHARP(38),FLAT(38),STAFF(1884),NOTE1(38),NOTE2(38),NOTE4(38),NOTE8(38),NOTE16(38),NOTE32(38),NOTE64(38),BLOCK(31,2),M$(MAX),IB$(99),PCL(104),PCC(104),PCR(104)
  7. 120 DIM REST1(38),REST2(38),REST4(38),REST8(38),REST16(38),REST32(38),REST64(38),PIANOL(104),PIANOR(104),PIANOC(104),DOT(38),NDY(35),BK(5):DEF FNU$(A$)=CHR$(ASC(A$+CHR$(13))+32*(LEFT$(A$,1)>"Z"))
  8. 140 GOSUB 13000:CLS:LOCATE 12,20-LEN(X$)/2:X$="Just a moment...":PRINT X$:X!=FRE(A$):GOSUB 16170:GOSUB 2000:GOSUB 15000:GOSUB 14000
  9. 1000 GOSUB 24000:IN$=AZ$
  10. 1010 IF IN$="S" AND INSERTING=0 THEN GOSUB 18000:GOTO 1150
  11. 1020 IF IN$="L" AND INSERTING=0 THEN GOSUB 17000:GOTO 1150
  12. 1025 IF IN$="I" THEN GOSUB 25000:GOSUB 27300:GOTO 1150
  13. 1030 IF IN$="P" AND INSERTING=0 THEN GOSUB 19000:GOTO 1150
  14. 1035 IF IN$="D" AND INSERTING=0 THEN GOSUB 26000:GOSUB 27300:GOTO 1150
  15. 1040 IF IN$="T" THEN GOSUB 20000:GOTO 1150
  16. 1045 IF IN$=" " THEN GOSUB 11000:NOTE=NOT NOTE:GOTO 1150
  17. 1050 IF IN$="N" AND INSERTING=0 THEN GOSUB 21000:GOSUB 27300:GOTO 1150
  18. 1055 IF IN$="C" AND INSERTING=0 THEN GOSUB 22000:GOTO 1150
  19. 1060 IF IN$=CHR$(13) THEN GOSUB 16000:GOTO 1150
  20. 1065 IF IN$=CHR$(3) AND INSERTING=0 THEN GOSUB 23000:GOTO 1150
  21. 1070 IF ASC(LEFT$(IN$,1))<>0 THEN GOSUB 50000:GOTO 1000 ELSE IN=ASC(RIGHT$(IN$,1))
  22. 1080 IF IN<59 OR (IN>68 AND IN<72) OR IN=73 OR IN=79 OR IN>80 THEN GOSUB 50000:GOTO 1000
  23. 1090 IF IN=72 THEN ON NOTE+2 GOSUB 3000,50000:GOTO 1150
  24. 1100 IF IN=75 THEN GOSUB 6000:GOTO 1150
  25. 1110 IF IN=77 THEN GOSUB 5000:GOTO 1150
  26. 1120 IF IN=80 THEN ON NOTE+2 GOSUB 4000,50000:GOTO 1150
  27. 1130 IF IN>60 AND IN<>63 AND (INSERTING OR NCOUNT=1) THEN GOSUB 50000:GOTO 1000
  28. 1140 ON IN-58 GOSUB 8000,7000,27000,27100,27200,27700,27500,27600,9000,10000
  29. 1150 GOSUB 2000
  30. 1160 GOSUB 12000:IF IN$<>"" THEN IF ASC(LEFT$(IN$,1))=0 AND NOTE AND TEMPO>31 THEN PLAY "MB T255 L64 O=OC;"+N$
  31. 1170 GOTO 1000
  32. 2000 N$=MID$(PTN$,PTNPTR,2):CN$=LEFT$(N$,1):AC$=RIGHT$(N$,1):IF AC$=" " THEN SHARP=FALSE:FLAT=FALSE
  33. 2030 IF AC$="#" THEN SHARP=TRUE:FLAT=FALSE
  34. 2040 IF AC$="-" THEN SHARP=FALSE:FLAT=TRUE
  35. 2060 OC=((PTNPTR-1)/2-INSTR(PSCALE$,CN$))/12+1:NN=7*OC+INSTR(SCALE$,CN$)-7:RETURN
  36. 3000 GOSUB 11000:PTNPTR=PTNPTR+2:IF PTNPTR>119 THEN PTNPTR=1
  37. 3010 RETURN
  38. 4000 GOSUB 11000:PTNPTR=PTNPTR-2:IF PTNPTR<1 THEN PTNPTR=119
  39. 4010 RETURN
  40. 5000 GOSUB 11000:IF NOTE THEN 5050
  41. 5020 IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
  42. 5030 RETURN
  43. 5050 IF DOTTED THEN DOTTED=FALSE:RETURN
  44. 5060 DOTTED=TRUE:IF TIME=64 THEN TIME=1 ELSE TIME=TIME*2
  45. 5070 RETURN
  46. 6000 GOSUB 11000:IF NOTE THEN 6040
  47. 6010 IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
  48. 6020 RETURN
  49. 6040 IF NOT DOTTED THEN DOTTED=TRUE:RETURN
  50. 6050 DOTTED=FALSE:IF TIME=1 THEN TIME=64 ELSE TIME=TIME/2
  51. 6060 RETURN
  52. 7000 GOSUB 11000:PTNPTR=PTNPTR+24:IF PTNPTR>119 THEN PTNPTR=PTNPTR-120
  53. 7010 RETURN
  54. 8000 GOSUB 11000:PTNPTR=PTNPTR-24:IF PTNPTR<1 THEN PTNPTR=PTNPTR+120
  55. 8010 RETURN:GOSUB 11000:IF NPOS=1 THEN RETURN
  56. 9000 :GOSUB 11000
  57. 9010 IF NPOS=1 THEN GOSUB 50000:RETURN
  58. 9020 NPOS=NPOS-1
  59. 9060 GOTO 27300
  60. 10000 GOSUB 11000
  61. 10010 IF NPOS=NCOUNT THEN GOSUB 50000:RETURN
  62. 10020 NPOS=NPOS+1
  63. 10060 GOTO 27300
  64. 11000 PREVTIME=TIME:PREVDOT=DOTTED:PREVNOTE=NOTE:PREVPTR=PTNPTR:RETURN
  65. 12000 PREVN$=MID$(PTN$,PREVPTR,2):PREVAC$=RIGHT$(PREVN$,1):PREVOC=((PREVPTR-1)/2-INSTR(PSCALE$,LEFT$(PREVN$,1)))/12+1:PREVNN=7*PREVOC+INSTR(SCALE$,LEFT$(PREVN$,1))-7:N2$=N$:IF AC$="-" THEN MID$(N2$,2,1)="b"
  66. 12010 LOCATE 2,2:IF NPOS<NCOUNT THEN IF INSERTING THEN PRINT "Inserting ..." ELSE PRINT "Editing ...  " ELSE PRINT SPC(13)
  67. 12020 IF MID$(M$(NPOS),10,1)="P" OR NOT NOTE THEN N2$="RST"
  68. 12030 IF NPOS=NCOUNT AND TEMPO<32 THEN TEMPO=100
  69. 12040 FOR X=BCOUNT TO 1 STEP -1:IF NPOS=>BLOCK(X,1) AND NPOS<=BLOCK(X,2) THEN LOCATE 19,2:PRINT SPC(13):LOCATE 19,2:PRINT "#";FNS$(STR$(X));" [";FNS$(STR$(BLOCK(X,1)));":";FNS$(STR$(BLOCK(X,2)));"]":X=0
  70. 12045 NEXT X:IF X<>-1 THEN LOCATE 19,2:PRINT SPC(13)
  71. 12050 LOCATE 2,31:IF DOTTED OR LEFT$(N2$,1)="R" THEN PRINT USING "Tone  \ \";N2$+"." ELSE PRINT USING "Tone   \\";N2$
  72. 12060 LOCATE 5,31:PRINT USING "Octave  #";OC:LOCATE 3,31:PRINT USING "Note  ###";NPOS:LOCATE 4,31:IF TEMPO>31 THEN PRINT USING "Tempo ###";TEMPO ELSE PRINT USING "REPEAT ##";TEMPO
  73. 12070 LOCATE 7,31:PRINT USING "Blocks ##";BCOUNT:LOCATE 6,31:PRINT USING "Length ##";TIME
  74. 12100 OLDTX=FNL2!(PREVTIME)*15+RX:IF PREVNOTE AND PREVDOT THEN PUT (OLDTX,NY),DOT
  75. 12110 PUT (OLDTX,RY+20*PREVNOTE),NCURS:TX=RX+15*FNL2!(TIME):PUT (TX,RY+20*NOTE),NCURS:IF NOTE AND DOTTED THEN PUT (TX,RY+20*NOTE),DOT
  76. 12160 X=INSTR(SCALE$,LEFT$(PREVN$,1)):XQ=INT(X-X/3+.5):IF PREVAC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),0,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
  77. 12180 X=INSTR(SCALE$,LEFT$(N$,1)):XQ=INT(X-X/3+.5):IF AC$<>" " THEN PAINT (KBX+BK(XQ),KBY+5),1,2 ELSE IF X=2 OR X=5 OR X=6 THEN PUT (KBX+15*(X-1),KBY),PCC ELSE IF X=1 OR X=4 THEN PUT (KBX+15*(X-1),KBY),PCL ELSE PUT (KBX+15*(X-1),KBY),PCR
  78. 12190 KLUGE=TRUE
  79. 12210 IF NOT PREVNOTE THEN 12440
  80. 12220 ON FNL2!(PREVTIME)+1 GOTO 12230,12240,12250,12260,12270,12280,12290
  81. 12230 PUT (NDX,NDY(PREVNN)),NOTE1:GOTO 12300
  82. 12240 PUT (NDX,NDY(PREVNN)),NOTE2:GOTO 12300
  83. 12250 PUT (NDX,NDY(PREVNN)),NOTE4:GOTO 12300
  84. 12260 PUT (NDX,NDY(PREVNN)),NOTE8:GOTO 12300
  85. 12270 PUT (NDX,NDY(PREVNN)),NOTE16:GOTO 12300
  86. 12280 PUT (NDX,NDY(PREVNN)),NOTE32:GOTO 12300
  87. 12290 PUT (NDX,NDY(PREVNN)),NOTE64
  88. 12300 IF PREVDOT THEN PUT (NDX,NDY(PREVNN)),DOT
  89. 12310 IF PREVAC$="-" THEN PUT (NDX-2,NDY(PREVNN)),FLAT ELSE IF PREVAC$="#" THEN PUT (NDX-2,NDY(PREVNN)),SHARP
  90. 12320 IF NOT NOTE THEN 12520 ELSE ON FNL2!(TIME)+1 GOTO 12330,12340,12350,12360,12370,12380,12390
  91. 12330 PUT (NDX,NDY(NN)),NOTE1:GOTO 12400
  92. 12340 PUT (NDX,NDY(NN)),NOTE2:GOTO 12400
  93. 12350 PUT (NDX,NDY(NN)),NOTE4:GOTO 12400
  94. 12360 PUT (NDX,NDY(NN)),NOTE8:GOTO 12400
  95. 12370 PUT (NDX,NDY(NN)),NOTE16:GOTO 12400
  96. 12380 PUT (NDX,NDY(NN)),NOTE32:GOTO 12400
  97. 12390 PUT (NDX,NDY(NN)),NOTE64
  98. 12400 IF DOTTED THEN PUT (NDX,NDY(NN)),DOT
  99. 12410 IF AC$="-" THEN PUT (NDX-2,NDY(NN)),FLAT ELSE IF AC$="#" THEN PUT (NDX-2,NDY(NN)),SHARP
  100. 12420 RETURN
  101. 12440 IF PREVNOTE THEN 12320 ELSE ON FNL2!(PREVTIME)+1 GOTO 12450,12460,12470,12480,12490,12500,12510
  102. 12450 PUT (RDX,RDY),REST1:GOTO 12320
  103. 12460 PUT (RDX,RDY),REST2:GOTO 12320
  104. 12470 PUT (RDX,RDY),REST4:GOTO 12320
  105. 12480 PUT (RDX,RDY),REST8:GOTO 12320
  106. 12490 PUT (RDX,RDY),REST16:GOTO 12320
  107. 12500 PUT (RDX,RDY),REST32:GOTO 12320
  108. 12510 PUT (RDX,RDY),REST64:GOTO 12320
  109. 12520 ON FNL2!(TIME)+1 GOTO 12530,12540,12550,12560,12570,12580,12590
  110. 12530 PUT (RDX,RDY),REST1:RETURN
  111. 12540 PUT (RDX,RDY),REST2:RETURN
  112. 12550 PUT (RDX,RDY),REST4:RETURN
  113. 12560 PUT (RDX,RDY),REST8:RETURN
  114. 12570 PUT (RDX,RDY),REST16:RETURN
  115. 12580 PUT (RDX,RDY),REST32:RETURN
  116. 12590 PUT (RDX,RDY),REST64:RETURN
  117. 13000 SCREEN 1:CLS:COLOR 0,1:STAFF$="S10 A000 BM000,000 C2 D8 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":STAFF$=STAFF$+" L1 D16 R1 U8 L1 R1 BR40 D8 R1 U8 L1 L40 D2 R40 D2 L40 D2 R40 D2 L40":DRAW STAFF$:STAFF$=""
  118. 13030 GET(0,0)-(104,70),STAFF:CLS
  119. 13050 CIRCLE (4,13),3,3,,,.55:GET (0,0)-(13,17),NOTE1:LINE (7,12)-(6,1),3,B:GET (0,0)-(13,17),NOTE2:PAINT (4,13),3,3:GET (0,0)-(13,17),NOTE4:LINE (7,1)-(12,3),3:GET (0,0)-(13,17),NOTE8:LINE (7,3)-(12,5),3:GET (0,0)-(13,17),NOTE16
  120. 13060 LINE (7,5)-(12,7),3:GET (0,0)-(13,17),NOTE32:LINE (7,7)-(12,9),3:GET (0,0)-(13,17),NOTE64:CLS
  121. 13080 LINE(2,0)-(2,6),3:LINE (4,0)-(4,6),3:LINE (1,2)-(5,2),3:LINE (1,4)-(5,4),3:GET (0,0)-(13,17),SHARP:CLS:LINE (2,0)-(2,6),3:LINE (2,6)-(6,4),3:LINE (6,4)-(2,2),3:GET (0,0)-(13,17),FLAT
  122. 13100 CLS:LINE (3,11)-(9,13),3,BF:GET (0,0)-(13,17),REST1:CLS:LINE (3,9)-(9,7),3,BF:GET (0,0)-(13,17),REST2:CLS:LINE (6,3)-(8,5),3:LINE (8,5)-(6,8),3:LINE (6,8)-(8,10),3:LINE (8,10)-(5,13),3:LINE (5,13)-(6,15),3:GET (0,0)-(13,17),REST4
  123. 13110 PUT (1,0),REST4:GET (0,0)-(13,17),REST4:CLS:LINE (6,14)-(9,3),3:LINE (7,14)-(10,3),3:LINE (9,4)-(3,6),3:GET (0,0)-(13,17),REST8:LINE (9,6)-(3,8),3:GET (0,0)-(13,17),REST16:LINE (7,8)-(3,10),3:GET (0,0)-(13,17),REST32
  124. 13130 LINE (7,10)-(3,12),3:GET (0,0)-(13,17),REST64:CLS:LINE (0,0)-(9,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOL
  125. 13131 PAINT (5,5),2,0:GET (0,0)-(12,50),PCL
  126. 13132 CLS:LINE (4,0)-(9,30),3,BF:LINE(0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOC
  127. 13133 PAINT (5,5),2,0:GET (0,0)-(12,50),PCC
  128. 13134 CLS:LINE (4,0)-(12,30),3,BF:LINE (0,30)-(12,50),3,BF:GET (0,0)-(12,50),PIANOR
  129. 13135 PAINT (5,5),2,0:GET (0,0)-(12,50),PCR
  130. 13140 CLS:LINE (0,0)-(13,17),3,BF:GET (0,0)-(13,17),NCURS:CLS:LINE (10,14)-(11,15),3,B:GET (0,0)-(13,17),DOT:RETURN
  131. 14000 CLS:LINE (0,0)-(319,199),3,B:LINE (1,1)-(318,198),3,B:LINE (114,0)-(115,199),3,B:LINE (115,62)-(319,63),3,B:LINE (234,0)-(235,63),3,B
  132. 14030 PUT (KBX,KBY),PIANOL:PUT (KBX+15,KBY),PIANOC:PUT (KBX+30,KBY),PIANOR:PUT (KBX+45,KBY),PIANOL:PUT (KBX+60,KBY),PIANOC:PUT (KBX+75,KBY),PIANOC:PUT (KBX+90,KBY),PIANOR:LINE (KBX-3,KBY-2)-(KBX+105,KBY+52),3,B:PAINT (KBX+11,KBY+1),2,3
  133. 14050 FOR X=KBX+10 TO KBX+25 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X:FOR X=KBX+55 TO KBX+55+30 STEP 15:LINE (X+1,KBY)-(X+7,KBY+28),0,BF:NEXT X
  134. 14060 PUT (KBX,KBY),PCL
  135. 14070 LINE (0,NY-1)-(115,NY-2),3,B:PUT (NX,NY),NOTE1:PUT (NX+15,NY),NOTE2:PUT (NX+30,NY),NOTE4:PUT (NX+45,NY),NOTE8:PUT (NX+60,NY),NOTE16:PUT (NX+75,NY),NOTE32:PUT (NX+90,NY),NOTE64:TX=RX+15*FNL2!(TIME):PUT (TX,NY),NCURS
  136. 14090 LINE (0,RY-1)-(115,RY-2),3,B:PUT (RX,RY),REST1:PUT (RX+15,RY),REST2:PUT (RX+30,RY),REST4:PUT (RX+45,RY),REST8:PUT (RX+60,RY),REST16:PUT (RX+75,RY),REST32:PUT (RX+90,RY),REST64:PUT (STAFFX,STAFFY),STAFF
  137. 14120 FOR X=1 TO 5:LINE (STAFFX+46,STAFFY-X*5)-(STAFFX+60,STAFFY-X*5),2:LINE (STAFFX+46,STAFFY+X*5+45)-(STAFFX+60,STAFFY+X*5+45),2:NEXT X:LINE (STAFFX+46,STAFFY+MIDC)-(STAFFX+60,STAFFY+MIDC),2:PUT (NDX,NDY(NN)),NOTE4
  138. 14160 GOSUB 12000:LOCATE 13,21:DEF SEG:POKE 78,1:PRINT"PC Blues Box 2":LOCATE 15,21:POKE 78,2:PRINT "A Music Editor":LOCATE 16,21:PRINT "For The IBM PC"
  139. 14162 POKE 78,3:LOCATE 18,20:PRINT "by Fred J. Condo":LOCATE 19,20:PRINT "and Alan J. Zett":ERASE STAFF,PIANOL,PIANOC,PIANOR
  140. 14165 PLAY "MBT105O2L16C#FA-B-BB-A-FC#FA-B-BB-A-FF#B-O3C#E-EE-C#O2B-C#FA-B-BB-A-FA-O1A-O2A-GF#O1F#O2F#EC#.O3P8P32.C#":FOR X=19 TO 13 STEP -1:LOCATE X,16:PRINT SPC(24):NEXT
  141. 14170 LOCATE 10,16:PRINT "F1 DOWN   Octave   UP F2"
  142. 14190 LOCATE 11,16:PRINT "F3 START  Block   END F4"
  143. 14200 LOCATE 12,16:PRINT "F5 REPT.  BlocK   DEL F6"
  144. 14210 LOCATE 13,16:PRINT "F7 PREV.  Block  NEXT F8"
  145. 14220 LOCATE 14,16:PRINT "F9 PREV.  Note   NEXT F0"
  146. 14230 LOCATE 15,16:PRINT "I  INSRT  Note    DEL  D"
  147. 14240 LOCATE 16,16:PRINT "N  NOTE   Edit  TEMPO  T"
  148. 14250 LOCATE 17,16:PRINT "S  SAVE   File   LOAD  L"
  149. 14260 LOCATE 18,16:PRINT "C  CLEAR  Music  PLAY  P"
  150. 14265 LOCATE 19,16:PRINT "[Esc] Stop / Quit Ctrl-C"
  151. 14270 RETURN
  152. 15000 RESTORE:FOR X=1 TO 35:READ NDY(X):NDY(X)=NDY(X)+STAFFY:NEXT
  153. 15002 DATA 57,55,52,50,47,45,42,40,37,35,32,30,27,25,17,10,7,5,2,0,-3,-5,-8,-10,-13,-15,-18,-20,-23,-25,-28,-30,-33,-35,-38
  154. 15004 FOR X=1 TO 5:READ BK(X):NEXT:RETURN
  155. 15006 DATA 15,30,60,75,90,
  156. 16000 GOSUB 11000:IF NCOUNT=MAX THEN GOSUB 50000:RETURN ELSE M$="T000O0L00Na ":LZ=-((TEMPO<10)+(TEMPO<100)):MID$(M$,2+LZ)=FNS$(STR$(TEMPO)):MID$(M$,6)=FNS$(STR$(OC)):LZ=-(TIME<10):MID$(M$,8+LZ)=FNS$(STR$(TIME))
  157. 16060 IF NOT NOTE THEN MID$(M$,10)="P"+FNS$(STR$(TIME)) ELSE MID$(M$,10)=N$:IF DOTTED THEN MID$(M$,12)="."
  158. 16070 IF NOTE AND TEMPO>31 THEN PLAY M$
  159. 16080 IF INSERTING THEN IBL=IBL+1:IB$(IBL)=M$:RETURN ELSE M$(NPOS)=M$
  160. 16090 NPOS=NPOS+1
  161. 16110 IF NPOS>NCOUNT THEN NCOUNT=NCOUNT+1
  162. 16120 IF NPOS=NCOUNT THEN IF TEMPO<32 THEN TEMPO=100:RETURN ELSE RETURN
  163. 16160 GOTO 27310
  164. 16170 FOR X=1 TO 10:KEY X, "":NEXT X:RETURN
  165. 17000 :GOSUB 11000:LOCATE 22,16:PRINT "File? ";:AZ=14:GOSUB 24010:F$=AZ$:LOCATE 22,16:PRINT SPC(24):IF F$<"A" THEN RETURN ELSE OPEN F$ FOR INPUT AS #1:INPUT #1,X,X:IF X=0 THEN 17120 ELSE CLOSE #1:OPEN F$ FOR INPUT AS #1
  166. 17010 IF NCOUNT>1 THEN LOCATE 22,16:PRINT "Append? (Y/N)";:GOSUB 24000:X$=AZ$:IF X$="Y" THEN 17050
  167. 17020 INPUT #1,BCOUNT:INPUT #1,NCOUNT:NPOS=NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:INPUT #1,BLOCK(X,1):INPUT #1,BLOCK(X,2):NEXT X
  168. 17030 BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:INPUT #1,M$(X):NEXT X:GOTO 17100
  169. 17050 INPUT #1,AZ:INPUT #1,ZA:NPOS=NCOUNT+ZA-1:IF BCOUNT+AZ>29 OR NCOUNT+ZA>MAX-1 THEN GOSUB 50000:GOTO 17110 ELSE IF AZ<>0 THEN FOR X=1 TO AZ:INPUT #1,BLOCK(BCOUNT+X,1):INPUT #1,BLOCK(BCOUNT+X,2):NEXT X
  170. 17060 FOR X=1 TO AZ:BLOCK(BCOUNT+X,1)=BLOCK(BCOUNT+X,1)+NCOUNT-1:BLOCK(BCOUNT+X,2)=BLOCK(BCOUNT+X,2)+NCOUNT-1:NEXT X:BPOS=BCOUNT+AZ:FOR X=0 TO AZ-2:INPUT #1,M$(NCOUNT+X):NEXT X
  171. 17070 FOR X=NCOUNT TO NPOS-1:R=VAL(MID$(M$(X),2,3)):IF R<32 THEN R=R+BCOUNT
  172. 17080 MID$(M$(X),2,3)=RIGHT$("00"+FNS$(STR$(R)),3):NEXT X
  173. 17100 LOCATE 22,16:PRINT "Adjusting buffer ...":X!=FRE(A$):BCOUNT=BPOS:NCOUNT=NPOS:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49
  174. 17110 LOCATE 22,16:PRINT SPC(24):CLOSE #1:RETURN
  175. 17120 LOCATE 22,16:BEEP:PRINT "NOT A MUSIC FILE":FOR X=1 TO 1000:NEXT X:GOTO 17110
  176. 18000 IF NCOUNT<2 THEN GOSUB 50000:RETURN ELSE GOSUB 11000:LOCATE 22,16:PRINT "File? ";:AZ=14:GOSUB 24010:F$=AZ$:LOCATE 22,16:PRINT SPC(24):IF F$<"A" THEN RETURN ELSE OPEN F$ FOR OUTPUT AS #1
  177. 18010 PRINT #1,BCOUNT:PRINT #1,NCOUNT:IF BCOUNT<>0 THEN FOR X=1 TO BCOUNT:PRINT #1,BLOCK(X,1):PRINT #1,BLOCK(X,2):NEXT X
  178. 18060 BPOS=BCOUNT:FOR X=1 TO NCOUNT-1:PRINT #1,M$(X):NEXT X:CLOSE #1:NPOS=NCOUNT:TIME=4:DOTTED=FALSE:NOTE=TRUE:PTNPTR=49:RETURN
  179. 19000 GOSUB 11000:R=O:IF NCOUNT=1 THEN GOSUB 50000:RETURN ELSE PLAY "MB":LOCATE 22,16:PRINT "Start? ";:AZ=4:GOSUB 24010:X$=AZ$:IF VAL(X$)<1 OR VAL(X$)>NCOUNT-1 THEN X$="1"
  180. 19010 LOCATE 22,16:PRINT SPC(24):LOCATE 22,16:PRINT "End? ";:AZ=3:GOSUB 24010:IF VAL(AZ$)<VAL(X$) OR VAL(AZ$)>NCOUNT-1 THEN AZ$=STR$(NCOUNT-1)
  181. 19020 LOCATE 22,16:PRINT "Now playing ...":FOR X=VAL(X$) TO VAL(AZ$):IF INKEY$=CHR$(27) THEN 25100
  182. 19030 IF VAL(MID$(M$(X),2,3))<32 THEN 19050 ELSE PLAY M$(X)
  183. 19040 NEXT:GOTO 25100
  184. 19050 R=VAL(MID$(M$(X),2,3)):IF R<1 OR R>BCOUNT THEN 19100
  185. 19060 FOR AZ=BLOCK(R,1) TO BLOCK(R,2):IF INKEY$=CHR$(27) THEN 25100
  186. 19070 IF VAL(MID$(M$(AZ),2,3))<32 THEN 19100 ELSE PLAY M$(AZ)
  187. 19080 NEXT:GOTO 19040
  188. 19100 GOSUB 11000:LOCATE 22,16:PRINT "Repeat Error !!":FOR X=1 TO 1000:NEXT X:GOTO 25100
  189. 20000 GOSUB 11000:LOCATE 22,16:PRINT "Tempo (32-255)? ";:AZ=3:GOSUB 24010:X$=AZ$:IF VAL(X$)<32 OR VAL(X$)>255 THEN 20050 ELSE TEMPO=VAL(X$):LOCATE 22,16:PRINT SPC(24):IF INSERTING THEN RETURN
  190. 20010 LOCATE 22,16:PRINT "Global? (Y/N)":GOSUB 24000:X$=AZ$:IF X$<>"Y" THEN 20050 ELSE LOCATE 22,16:PRINT SPC(24):LOCATE 22,16:PRINT "Start? ";:AZ=4:GOSUB 24010:X$=AZ$:IF VAL(X$)<1 OR VAL(X$)>NCOUNT-1 THEN X$="1"
  191. 20020 LOCATE 22,16:PRINT SPC(24):LOCATE 22,16:PRINT "End? ";:AZ=4:GOSUB 24010:IF VAL(AZ$)<VAL(X$) OR VAL(AZ$)>NCOUNT-1 THEN AZ$=STR$(NCOUNT-1)
  192. 20030 LOCATE 22,16:PRINT SPC(24):LOCATE 22,16:PRINT "Adjusting Tempo ...":FOR X=VAL(X$) TO VAL(AZ$):IF MID$(M$(X),2,3)>"031" THEN MID$(M$(X),2)=RIGHT$("00"+FNS$(STR$(TEMPO)),3)
  193. 20040 NEXT X
  194. 20050 LOCATE 22,16:PRINT SPC(24):RETURN
  195. 21000 GOSUB 11000:IF NCOUNT=1 THEN GOSUB 50000:RETURN ELSE LOCATE 22,16:PRINT "Edit Note? ";:AZ=3:GOSUB 24010:X$=AZ$:LOCATE 22,16:PRINT SPC(24):IF VAL(X$)<1 THEN RETURN ELSE IF VAL(X$)>NCOUNT-1 THEN NPOS=NCOUNT:RETURN
  196. 21010 NPOS=VAL(X$):C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  197. 21060 TEMPO=VAL(MID$(M$(NPOS),2,3)):SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  198. 22000 GOSUB 11000:LOCATE 22,16:PRINT "Sure? (Y/N) ";:GOSUB 24000:X$=AZ$:LOCATE 22,16:PRINT SPC(24)
  199. 22010 IF X$=CHR$(13) THEN RETURN
  200. 22020 IF X$<>"Y" THEN RETURN
  201. 22030 BCOUNT=0:NCOUNT=1:NPOS=1:TIME=4:NOTE=TRUE:DOTTED=FALSE:PTNPTR=49:TIME=4:LOCATE 22,16:PRINT "Clearing ...":ERASE M$:DIM M$(MAX):X!=FRE(A$):LOCATE 22,16:PRINT SPC(24):RETURN
  202. 23000 LOCATE 22,16:PRINT "Sure? (Y/N)";:GOSUB 24000:X$=AZ$:LOCATE 22,16:PRINT STRING$(24,32):IF X$=CHR$(13) THEN RETURN
  203. 23010 IF X$<>"Y" THEN RETURN ELSE SCREEN 0,0,0:WIDTH 40:COLOR 11,0:CLS:END
  204. 24000 AZ$=INKEY$:IF AZ$="" THEN 24000 ELSE IF LEFT$(AZ$,1)=CHR$(0) THEN RETURN ELSE AZ$=FNU$(AZ$):RETURN
  205. 24010 AZ$="":ZA$="":PRINT CHR$(95+63*(ZA>10));:IF AZ=0 THEN AZ=255
  206. 24020 ZA$=INKEY$:IF ZA$>CHR$(31) AND ZA$<CHR$(123) AND AZ>0 THEN PRINT CHR$(29);ZA$;CHR$(95+63*(ZA>10));:AZ$=AZ$+ZA$:AZ=AZ-1
  207. 24030 IF ZA$<>"" AND ZA$<>CHR$(8) THEN SOUND 1100,.1
  208. 24040 IF ZA$=CHR$(13) THEN PRINT CHR$(29);" ";:RETURN
  209. 24050 IF ZA$=CHR$(8) THEN SOUND 1600,.1:IF LEN(AZ$)>0 THEN PRINT CHR$(29);CHR$(29);CHR$(95+63*(ZA>10));" ";CHR$(29);:AZ=AZ+1:IF LEN(AZ$)>1 THEN AZ$=LEFT$(AZ$,LEN(AZ$)-1) ELSE PRINT CHR$(29);:GOTO 24010
  210. 24060 ZA=ZA+4:PRINT CHR$(29);CHR$(95+63*(ZA>10));:IF ZA>20 THEN ZA=0
  211. 24070 GOTO 24020
  212. 25000 GOSUB 11000:IF NPOS=NCOUNT THEN GOSUB 50000:RETURN ELSE IF INSERTING=0 THEN INSERTING=NPOS:IBL=0:RETURN ELSE IF IBL=0 THEN INSERTING=0:RETURN
  213. 25010 LOCATE 22,16:PRINT "Adjusting buffer ...":FOR X=NCOUNT-1 TO INSERTING STEP -1:M$(X+IBL)=M$(X):NEXT X:NCOUNT=NCOUNT+IBL:NPOS=NPOS+IBL:FOR X=0 TO IBL-1:M$(X+INSERTING)=IB$(X+1):NEXT X
  214. 25020 IF BCOUNT=0 THEN 25100 ELSE FOR X=1 TO BCOUNT:IF BLOCK(X,1)=>INSERTING THEN BLOCK(X,1)=BLOCK(X,1)+IBL
  215. 25030 IF BLOCK(X,2)=>INSERTING THEN BLOCK(X,2)=BLOCK(X,2)+IBL
  216. 25040 NEXT X:X!=FRE(A$)
  217. 25100 LOCATE 22,16:PRINT SPC(24):INSERTING=0:RETURN
  218. 26000 GOSUB 11000:IF NPOS=NCOUNT THEN GOSUB 50000:RETURN ELSE LOCATE 22,16:PRINT "How many? ";:AZ=3:GOSUB 24010:X$=AZ$
  219. 26010 IF VAL(X$)=0 THEN 25100 ELSE IF NPOS+VAL(X$)=>NCOUNT THEN NCOUNT=NPOS:IF NPOS=1 THEN 22030 ELSE 25100
  220. 26020 IF BCOUNT=0 THEN 25100 ELSE AZ=31:BLOCK(AZ,1)=NPOS:BLOCK(AZ,2)=NPOS+VAL(X$)-1:X$="D":GOTO 27715
  221. 27000 GOSUB 11000:IF BS OR BCOUNT=30 THEN GOSUB 50000:RETURN ELSE FOR X=1 TO BCOUNT:IF NPOS=BLOCK(X,1) THEN GOSUB 50000:RETURN ELSE NEXT X:BCOUNT=BCOUNT+1:BS=-1:IF BCOUNT=1 THEN BLOCK(1,1)=NPOS:BLOCK(1,2)=0:BPOS=1:RETURN
  222. 27010 LOCATE 22,16:PRINT "Adjust Repeats? (Y/N)":GOSUB 24000:X$=AZ$:LOCATE 22,16:PRINT "Adjusting buffer ...";SPC(4):BPOS=0:FOR X=1 TO BCOUNT-1:IF NPOS<BLOCK(X,1) THEN BPOS=X
  223. 27020 NEXT X:IF BPOS=0 THEN BLOCK(BCOUNT,1)=NPOS:BLOCK(BCOUNT,2)=0:BPOS=BCOUNT:GOTO 25100
  224. 27030 FOR X=BCOUNT-1 TO BPOS STEP -1:BLOCK(X+1,1)=BLOCK(X,1):BLOCK(X+1,2)=BLOCK(X,2):NEXT:BLOCK(BPOS,1)=NPOS:BLOCK(BPOS,2)=0:IF X$="N" THEN 25100
  225. 27040 FOR X=1 TO NCOUNT-1:R=VAL(MID$(M$(X),2,3)):IF R<32 AND R=>BPOS THEN R=R+1
  226. 27050 MID$(M$(X),2,3)=RIGHT$("00"+FNS$(STR$(R)),3):NEXT X:GOTO 25100
  227. 27100 GOSUB 11000:IF BCOUNT=0 THEN GOSUB 50000:RETURN ELSE IF BS=0 OR BLOCK(BPOS,1)=>NPOS THEN GOSUB 50000:RETURN ELSE BLOCK(BPOS,2)=NPOS:BS=0:RETURN
  228. 27200 GOSUB 11000:IF BCOUNT=0 THEN GOSUB 50000:RETURN
  229. 27210 LOCATE 22,16:PRINT "Repeat Block? ";:AZ=2:GOSUB 24010:X$=AZ$:LOCATE 22,16:PRINT SPC(24):IF VAL(X$)<1 OR VAL(X$)>31 THEN RETURN ELSE IF VAL(X$)>BCOUNT THEN GOSUB 50000:RETURN
  230. 27220 AZ$="T"+RIGHT$("00"+X$,3)+"O3L04C ";:IF INSERTING THEN IB$(NPOS)=AZ$:IBL=IBL+1 ELSE M$(NPOS)=AZ$
  231. 27230 GOTO 16090
  232. 27300 IF NPOS>=NCOUNT THEN NPOS=NCOUNT:PTNPTR=49:TIME=4:DOTTED=FALSE:NOTE=TRUE:RETURN
  233. 27310 C7$=MID$(M$(NPOS),10,2):N7$=LEFT$(C7$,1):OC7=VAL(MID$(M$(NPOS),6,1)):DOTTED=(RIGHT$(M$(NPOS),1)="."):TIME=VAL(MID$(M$(NPOS),8,2)):NOTE=NOT (ASC(N7$)=80)
  234. 27320 TEMPO=VAL(MID$(M$(NPOS),2,3)):SH7=(RIGHT$(C7$,1)="#"):FL7=(RIGHT$(C7$,1)="-"):IF NOTE THEN PTNPTR=(12*(OC7-1)+INSTR(PSCALE$,N7$)-SH7+FL7)*2-1:RETURN ELSE PTNPTR=49:RETURN
  235. 27500 GOSUB 11000:IF BCOUNT=0 THEN GOSUB 50000:RETURN ELSE AZ=0:FOR X=1 TO BCOUNT:IF BLOCK(X,1)<NPOS THEN AZ=X
  236. 27510 NEXT X:IF AZ=0 THEN GOSUB 50000:RETURN ELSE NPOS=BLOCK(AZ,1):GOTO 27300
  237. 27600 GOSUB 11000:IF BCOUNT=0 THEN GOSUB 50000:RETURN ELSE AZ=0:FOR X=BCOUNT TO 1 STEP -1:IF BLOCK(X,1)>NPOS THEN AZ=X
  238. 27610 NEXT X:IF AZ=0 THEN GOSUB 50000:RETURN ELSE NPOS=BLOCK(AZ,1):GOTO 27300
  239. 27700 GOSUB 11000:IF BCOUNT=0 THEN GOSUB 50000:RETURN ELSE AZ=0:FOR X=1 TO BCOUNT:IF BLOCK(X,1)=NPOS THEN AZ=X
  240. 27710 NEXT X:IF AZ=0 THEN GOSUB 50000:RETURN ELSE LOCATE 22,16:PRINT "Unmark or Delete? (U/D)":GOSUB 24000:X$=AZ$:LOCATE 22,16:PRINT SPC(24):IF X$<>"U" AND X$<>"D" THEN RETURN
  241. 27715 LOCATE 22,16:PRINT "Delete Repeats? (Y/N)":GOSUB 24000
  242. 27720 LOCATE 22,16:PRINT "Adjusting buffer ...";SPC(4):IF X$="D" THEN FOR X=1 TO NCOUNT-BLOCK(AZ,2)-1:M$(BLOCK(AZ,1)+X-1)=M$(BLOCK(AZ,2)+X):NEXT X:R=BLOCK(AZ,2)-BLOCK(AZ,1)+1:NCOUNT=NCOUNT-R
  243. 27730 FOR X=1 TO BCOUNT:IF ((BLOCK(X,1)=>BLOCK(AZ,1) AND BLOCK(X,1)<=BLOCK(AZ,2)) OR (BLOCK(X,2)=>BLOCK(AZ,1) AND BLOCK(X,2)<=BLOCK(AZ,2))) AND X$="D" AND X<>AZ THEN BLOCK(X,1)=-1:BLOCK(X,2)=-1
  244. 27740 NEXT X:FOR X=1 TO BCOUNT:IF X$="D" AND BLOCK(X,1)>BLOCK(AZ,1) AND X<>AZ THEN BLOCK(X,1)=BLOCK(X,1)-R:BLOCK(X,2)=BLOCK(X,2)-R
  245. 27745 NEXT X:BLOCK(AZ,1)=-1:BLOCK(AZ,2)=-1:AZ=0
  246. 27750 AZ=AZ+1:IF AZ>BCOUNT THEN X!=FRE(A$):GOTO 25100 ELSE IF BLOCK(AZ,1)>0 THEN 27750
  247. 27760 FOR X=AZ TO BCOUNT:BLOCK(X,1)=BLOCK(X+1,1):BLOCK(X,2)=BLOCK(X+1,2):NEXT X:BCOUNT=BCOUNT-1:IF AZ$="N" THEN AZ=0:GOTO 27750 ELSE FOR X=1 TO NCOUNT-1:R=VAL(MID$(M$(X),2,3))
  248. 27770 IF R=AZ THEN M$(X)="X" ELSE IF R<32 AND R>AZ THEN MID$(M$(X),2,3)=RIGHTS("00"+FNS$(STR$(R-1)),3)
  249. 27780 NEXT X:FOR X=1 TO NCOUNT-1:IF M$(X)<>"X" THEN 27810 ELSE FOR R=X TO NCOUNT-1:M$(R)=M$(R+1):NEXT R:NCOUNT=NCOUNT-1:FOR R=1 TO BCOUNT:IF AZ=>BLOCK(R,1) AND X<=BLOCK(R,2) THEN BLOCK(R,2)=BLOCK(R,2)-1
  250. 27790 NEXT R:FOR R=1 TO BCOUNT:IF BLOCK(R,1)>=BLOCK(R,2) THEN BLOCK(R,1)=-1:BLOCK(R,2)=-1
  251. 27800 NEXT R:X=X-1
  252. 27810 NEXT X:AZ=0:GOTO 27750
  253. 30000 BEEP:X=ERR:LOCATE 22,16:IF X=53 THEN PRINT "FILE NOT FOUND":RESUME 30020 ELSE IF X=57 OR X>64 THEN PRINT "DISK ERROR":RESUME 30020 ELSE IF X=61 THEN PRINT "DISK FULL":RESUME 30020
  254. 30010 SCREEN 0,0,0:WIDTH 40:CLS:LOCATE 10,1:IF X>30 THEN PRINT "UNKNOWN ERROR";:RESUME 30030 ELSE PRINT "PROGRAM ERROR";:RESUME 30030
  255. 30020 FOR X=1 TO 2000:NEXT X:LOCATE 22,16:PRINT SPC(24):GOTO 1000
  256. 30030 PRINT X;"IN";ERL;"... BUG?":PRINT:PRINT "TO SAVE ANY CURRENT WORK, GOSUB 18000":PRINT:ON ERROR GOTO 0:END
  257. 50000 GOSUB 11000:LOCATE 22,16:PRINT "Invalid command ...":FOR X=1 TO 1000:NEXT X:LOCATE 22,16:PRINT SPC(24):RETURN
  258.